home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue30 / crossref / CRefCode / NewParse.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1997-10-02  |  8.9 KB  |  390 lines
  1. unit NewParse;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, SysUtils, Consts;
  7.  
  8. const
  9.   toComment = Char(5);
  10.  
  11. type
  12.   TNewParser = class(TObject)
  13.   private
  14.     FStream: TStream;
  15.     FOrigin: Longint;
  16.     FBuffer: PChar;
  17.     FBufPtr: PChar;
  18.     FBufEnd: PChar;
  19.     FSourcePtr: PChar;
  20.     FSourceEnd: PChar;
  21.     FTokenPtr: PChar;
  22.     FStringPtr: PChar;
  23.     FSourceLine: Integer;
  24.     FSaveChar: Char;
  25.     FToken: Char;
  26.     procedure ReadBuffer;
  27.     procedure SkipBlanks;
  28.   public
  29.     constructor Create(Stream: TStream);
  30.     destructor Destroy; override;
  31.     procedure CheckToken(T: Char);
  32.     procedure CheckTokenSymbol(const S: string);
  33.     procedure Error(const Ident: string);
  34.     procedure ErrorFmt(const Ident: string; const Args: array of const);
  35.     procedure ErrorStr(const Message: string);
  36.     procedure HexToBinary(Stream: TStream);
  37.     function NextToken: Char;
  38.     function SourcePos: Longint;
  39.     function TokenComponentIdent: String;
  40.     function TokenFloat: Extended;
  41.     function TokenInt: Longint;
  42.     function TokenString: string;
  43.     function TokenSymbolIs(const S: string): Boolean;
  44.     property SourceLine: Integer read FSourceLine;
  45.     property Token: Char read FToken;
  46.   end;
  47.  
  48. implementation
  49.  
  50. const
  51.   ParseBufSize = 4096;
  52.  
  53. {procedure BinToHex(Buffer, Text: PChar; BufSize: Integer); assembler;
  54. asm
  55.         PUSH    ESI
  56.         PUSH    EDI
  57.         MOV     ESI,EAX
  58.         MOV     EDI,EDX
  59.         MOV     EDX,0
  60.         JMP     @@1
  61. @@0:    DB      '0123456789ABCDEF'
  62. @@1:    LODSB
  63.         MOV     DL,AL
  64.         AND     DL,0FH
  65.         MOV     AH,@@0.Byte[EDX]
  66.         MOV     DL,AL
  67.         SHR     DL,4
  68.         MOV     AL,@@0.Byte[EDX]
  69.         STOSW
  70.         DEC     ECX
  71.         JNE     @@1
  72.         POP     EDI
  73.         POP     ESI
  74. end;}
  75.  
  76. function HexToBin(Text, Buffer: PChar; BufSize: Integer): Integer; assembler;
  77. asm
  78.         PUSH    ESI
  79.         PUSH    EDI
  80.         PUSH    EBX
  81.         MOV     ESI,EAX
  82.         MOV     EDI,EDX
  83.         MOV     EBX,EDX
  84.         MOV     EDX,0
  85.         JMP     @@1
  86. @@0:    DB       0, 1, 2, 3, 4, 5, 6, 7, 8, 9,-1,-1,-1,-1,-1,-1
  87.         DB      -1,10,11,12,13,14,15,-1,-1,-1,-1,-1,-1,-1,-1,-1
  88.         DB      -1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1
  89.         DB      -1,10,11,12,13,14,15
  90. @@1:    LODSW
  91.         CMP     AL,'0'
  92.         JB      @@2
  93.         CMP     AL,'f'
  94.         JA      @@2
  95.         MOV     DL,AL
  96.         MOV     AL,@@0.Byte[EDX-'0']
  97.         CMP     AL,-1
  98.         JE      @@2
  99.         SHL     AL,4
  100.         CMP     AH,'0'
  101.         JB      @@2
  102.         CMP     AH,'f'
  103.         JA      @@2
  104.         MOV     DL,AH
  105.         MOV     AH,@@0.Byte[EDX-'0']
  106.         CMP     AH,-1
  107.         JE      @@2
  108.         OR      AL,AH
  109.         STOSB
  110.         DEC     ECX
  111.         JNE     @@1
  112. @@2:    MOV     EAX,EDI
  113.         SUB     EAX,EBX
  114.         POP     EBX
  115.         POP     EDI
  116.         POP     ESI
  117. end;
  118.  
  119. constructor TNewParser.Create(Stream: TStream);
  120. begin
  121.   FStream := Stream;
  122.   GetMem(FBuffer, ParseBufSize);
  123.   FBuffer[0] := #0;
  124.   FBufPtr := FBuffer;
  125.   FBufEnd := FBuffer + ParseBufSize;
  126.   FSourcePtr := FBuffer;
  127.   FSourceEnd := FBuffer;
  128.   FTokenPtr := FBuffer;
  129.   FSourceLine := 1;
  130.   NextToken;
  131. end;
  132.  
  133. destructor TNewParser.Destroy;
  134. begin
  135.   if FBuffer <> nil then
  136.   begin
  137.     FStream.Seek(Longint(FTokenPtr) - Longint(FBufPtr), 1);
  138.     FreeMem(FBuffer, ParseBufSize);
  139.   end;
  140. end;
  141.  
  142. procedure TNewParser.CheckToken(T: Char);
  143. begin
  144.   if Token <> T then
  145.     case T of
  146.       toSymbol:
  147.         Error(SIdentifierExpected);
  148.       toString:
  149.         Error(SStringExpected);
  150.       toInteger, toFloat:
  151.         Error(SNumberExpected);
  152.     else
  153.       ErrorFmt(SCharExpected, [T]);
  154.     end;
  155. end;
  156.  
  157. procedure TNewParser.CheckTokenSymbol(const S: string);
  158. begin
  159.   if not TokenSymbolIs(S) then ErrorFmt(SSymbolExpected, [S]);
  160. end;
  161.  
  162. procedure TNewParser.Error(const Ident: string);
  163. begin
  164.   ErrorStr(Ident);
  165. end;
  166.  
  167. procedure TNewParser.ErrorFmt(const Ident: string; const Args: array of const);
  168. begin
  169.   ErrorStr(Format(Ident, Args));
  170. end;
  171.  
  172. procedure TNewParser.ErrorStr(const Message: string);
  173. begin
  174.   raise EParserError.CreateFmt(SParseError, [Message, FSourceLine]);
  175. end;
  176.  
  177. procedure TNewParser.HexToBinary(Stream: TStream);
  178. var
  179.   Count: Integer;
  180.   Buffer: array[0..255] of Char;
  181. begin
  182.   SkipBlanks;
  183.   while FSourcePtr^ <> '}' do
  184.   begin
  185.     Count := HexToBin(FSourcePtr, Buffer, SizeOf(Buffer));
  186.     if Count = 0 then Error(SInvalidBinary);
  187.     Stream.Write(Buffer, Count);
  188.     Inc(FSourcePtr, Count * 2);
  189.     SkipBlanks;
  190.   end;
  191.   NextToken;
  192. end;
  193.  
  194. function TNewParser.NextToken: Char;
  195. var
  196.   I: Integer;
  197.   P, S: PChar;
  198. begin
  199.   SkipBlanks;
  200.   P := FSourcePtr;
  201.   FTokenPtr := P;
  202.   case P^ of
  203.     'A'..'Z', 'a'..'z', '_':
  204.       begin
  205.         Inc(P);
  206.         while P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do Inc(P);
  207.         Result := toSymbol;
  208.       end;
  209.     '#', '''':
  210.       begin
  211.         S := P;
  212.         while True do
  213.           case P^ of
  214.             '#':
  215.               begin
  216.                 Inc(P);
  217.                 I := 0;
  218.                 while P^ in ['0'..'9'] do
  219.                 begin
  220.                   I := I * 10 + (Ord(P^) - Ord('0'));
  221.                   Inc(P);
  222.                 end;
  223.                 S^ := Chr(I);
  224.                 Inc(S);
  225.               end;
  226.             '''':
  227.               begin
  228.                 Inc(P);
  229.                 while True do
  230.                 begin
  231.                   case P^ of
  232.                     #0, #10, #13:
  233.                       Error(SInvalidString);
  234.                     '''':
  235.                       begin
  236.                         Inc(P);
  237.                         if P^ <> '''' then Break;
  238.                       end;
  239.                   end;
  240.                   S^ := P^;
  241.                   Inc(S);
  242.                   Inc(P);
  243.                 end;
  244.               end;
  245.           else
  246.             Break;
  247.           end;
  248.         FStringPtr := S;
  249.         Result := toString;
  250.       end;
  251.     '$':
  252.       begin
  253.         Inc(P);
  254.         while P^ in ['0'..'9', 'A'..'F', 'a'..'f'] do Inc(P);
  255.         Result := toInteger;
  256.       end;
  257.     '-', '0'..'9':
  258.       begin
  259.         Inc(P);
  260.         while P^ in ['0'..'9'] do Inc(P);
  261.         Result := toInteger;
  262.         while P^ in ['0'..'9', '.', 'e', 'E', '+', '-'] do
  263.         begin
  264.           Inc(P);
  265.           Result := toFloat;
  266.         end;
  267.       end;
  268.     // new custom code!!!!
  269.     '{':
  270.       begin
  271.         // look for closing brace
  272.         while (P^ <> '}') and (P^ <> toEOF) do ////////////// bug
  273.           Inc(P);
  274.         // move to the next
  275.         if (P^ <> toEOF) then
  276.           Inc(P);
  277.         Result := toComment;
  278.       end;
  279.   else
  280.     // updated
  281.     if (P^ = '/') and (P^ <> toEOF) and ((P+1)^ = '/') then
  282.     begin
  283.       // single line comment
  284.       while P^ <> #13 do
  285.         Inc(P);
  286.       Result := toComment;
  287.     end
  288.     else
  289.     begin
  290.       Result := P^;
  291.       if Result <> toEOF then
  292.         Inc(P);
  293.     end;
  294.   end;
  295.   FSourcePtr := P;
  296.   FToken := Result;
  297. end;
  298.  
  299. procedure TNewParser.ReadBuffer;
  300. var
  301.   Count: Integer;
  302. begin
  303.   Inc(FOrigin, FSourcePtr - FBuffer);
  304.   FSourceEnd[0] := FSaveChar;
  305.   Count := FBufPtr - FSourcePtr;
  306.   if Count <> 0 then Move(FSourcePtr[0], FBuffer[0], Count);
  307.   FBufPtr := FBuffer + Count;
  308.   Inc(FBufPtr, FStream.Read(FBufPtr[0], FBufEnd - FBufPtr));
  309.   FSourcePtr := FBuffer;
  310.   FSourceEnd := FBufPtr;
  311.   if FSourceEnd = FBufEnd then
  312.   begin
  313.     FSourceEnd := LineStart(FBuffer, FSourceEnd - 1);
  314.     if FSourceEnd = FBuffer then Error(SLineTooLong);
  315.   end;
  316.   FSaveChar := FSourceEnd[0];
  317.   FSourceEnd[0] := #0;
  318. end;
  319.  
  320. procedure TNewParser.SkipBlanks;
  321. begin
  322.   while True do
  323.   begin
  324.     case FSourcePtr^ of
  325.       #0:
  326.         begin
  327.           ReadBuffer;
  328.           if FSourcePtr^ = #0 then Exit;
  329.           Continue;
  330.         end;
  331.       #10:
  332.         Inc(FSourceLine);
  333.       #33..#255:
  334.         Exit;
  335.     end;
  336.     Inc(FSourcePtr);
  337.   end;
  338. end;
  339.  
  340. function TNewParser.SourcePos: Longint;
  341. begin
  342.   Result := FOrigin + (FTokenPtr - FBuffer);
  343. end;
  344.  
  345. function TNewParser.TokenFloat: Extended;
  346. begin
  347.   Result := StrToFloat(TokenString);
  348. end;
  349.  
  350. function TNewParser.TokenInt: Longint;
  351. begin
  352.   Result := StrToInt(TokenString);
  353. end;
  354.  
  355. function TNewParser.TokenString: string;
  356. var
  357.   L: Integer;
  358. begin
  359.   if FToken = toString then
  360.     L := FStringPtr - FTokenPtr else
  361.     L := FSourcePtr - FTokenPtr;
  362.   SetString(Result, FTokenPtr, L);
  363. end;
  364.  
  365. function TNewParser.TokenSymbolIs(const S: string): Boolean;
  366. begin
  367.   Result := (Token = toSymbol) and (CompareText(S, TokenString) = 0);
  368. end;
  369.  
  370. function TNewParser.TokenComponentIdent: String;
  371. var
  372.   P: PChar;
  373. begin
  374.   CheckToken(toSymbol);
  375.   P := FSourcePtr;
  376.   while P^ = '.' do
  377.   begin
  378.     Inc(P);
  379.     if not (P^ in ['A'..'Z', 'a'..'z', '_']) then
  380.       Error(SIdentifierExpected);
  381.     repeat
  382.       Inc(P)
  383.     until not (P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
  384.   end;
  385.   FSourcePtr := P;
  386.   Result := TokenString;
  387. end;
  388.  
  389. end.
  390.